home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
ELECTRIC
/
DSPICE0S.ZIP
/
extmem.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-11-22
|
4KB
|
141 lines
/* extmem.f -- translated by f2c (version of 3 February 1990 3:36:42).
You must link the resulting object file with the libraries:
-lF77 -lI77 -lm -lc (in that order)
*/
#include "f2c.h"
/* Common Block Declarations */
struct {
doublereal cpyknt;
integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk,
loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8,
nwd16;
} memmgr_;
#define memmgr_1 memmgr_
/* Table of constant values */
static integer c__2 = 2;
static integer c__0 = 0;
static integer c__1 = 1;
/*< subroutine extmem(ipntr,ksize) >*/
/* Subroutine */ int extmem_(ipntr, ksize)
integer *ipntr, *ksize;
{
static integer need, ltab1;
extern /* Subroutine */ int copy4_();
static integer isize, jsize;
extern /* Subroutine */ int memadj_(), errmem_(), comprs_();
extern logical memptr_();
extern integer nxtmem_();
extern /* Subroutine */ int memory_();
static integer nwords;
extern integer nxtevn_();
/* Parameter adjustments */
--ipntr;
/* Function Body */
/*< implicit double precision (a-h,o-z) >*/
/*< dimension ipntr(1) >*/
/* spice version 2g.6 sccsid=memmgr 3/15/83 */
/*< common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
/*< 1 ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
/*< 2 nwd8,nwd16 >*/
/*< logical memptr >*/
/* *** extmem - extend size of existing block */
/* ... check for valid pointer */
/*< if (memptr(ipntr(1))) go to 10 >*/
if (memptr_(&ipntr[1])) {
goto L10;
}
/*< memerr=5 >*/
memmgr_1.memerr = 5;
/*< call errmem(2,memerr,ipntr(1)) >*/
errmem_(&c__2, &memmgr_1.memerr, &ipntr[1]);
/*< 10 isize=ksize*istack(ltab+5) >*/
L10:
isize = *ksize * memmgr_1.istack[memmgr_1.ltab + 4];
/* ... check for valid size */
/*< if (isize.ge.0) go to 20 >*/
if (isize >= 0) {
goto L20;
}
/*< memerr=2 >*/
memmgr_1.memerr = 2;
/*< call errmem(2,memerr,ipntr(1)) >*/
errmem_(&c__2, &memmgr_1.memerr, &ipntr[1]);
/* ... check if enough space already there */
/*< 20 if ((istack(ltab+2)-istack(ltab+3)).ge.isize) go to 40 >*/
L20:
if (memmgr_1.istack[memmgr_1.ltab + 1] - memmgr_1.istack[memmgr_1.ltab +
2] >= isize) {
goto L40;
}
/*< need=nxtevn(isize)-memavl >*/
need = nxtevn_(&isize) - memmgr_1.memavl;
/*< if (need.le.0) go to 30 >*/
if (need <= 0) {
goto L30;
}
/* ... insufficient space -- bump memory size */
/*< need=nxtmem(need) >*/
need = nxtmem_(&need);
/*< icore=icore+need >*/
memmgr_1.icore += need;
/*< call memory >*/
memory_();
/*< if(memerr.ne.0) call errmem(2,memerr,ipntr(1)) >*/
if (memmgr_1.memerr != 0) {
errmem_(&c__2, &memmgr_1.memerr, &ipntr[1]);
}
/*< ltab1=ldval-ntab >*/
ltab1 = memmgr_1.ldval - memmgr_1.ntab;
/*< istack(ltab1+2)=istack(ltab1+2)+need >*/
memmgr_1.istack[ltab1 + 1] += need;
/* ... relocate block entry table */
/*< nwords=numblk*ntab >*/
nwords = memmgr_1.numblk * memmgr_1.ntab;
/*< cpyknt=cpyknt+dble(nwords) >*/
memmgr_1.cpyknt += (doublereal) nwords;
/*< call copy4(istack(loctab+1),istack(loctab+need+1),nwords) >*/
copy4_(&memmgr_1.istack[memmgr_1.loctab], &memmgr_1.istack[
memmgr_1.loctab + need], &nwords);
/*< loctab=loctab+need >*/
memmgr_1.loctab += need;
/*< ldval=ldval+need >*/
memmgr_1.ldval += need;
/*< memavl=memavl+need >*/
memmgr_1.memavl += need;
/*< ltab=ltab+need >*/
memmgr_1.ltab += need;
/* ... move blocks to make space */
/*< 30 continue >*/
L30:
/*< call comprs(0,ltab) >*/
comprs_(&c__0, &memmgr_1.ltab);
/*< call comprs(1,ltab) >*/
comprs_(&c__1, &memmgr_1.ltab);
/*< 40 jsize=istack(ltab+3) >*/
L40:
jsize = memmgr_1.istack[memmgr_1.ltab + 2];
/*< istack(ltab+3)=istack(ltab+3)+isize >*/
memmgr_1.istack[memmgr_1.ltab + 2] += isize;
/*< memavl=memavl-(nxtevn(istack(ltab+3))-nxtevn(jsize)) >*/
memmgr_1.memavl -= nxtevn_(&memmgr_1.istack[memmgr_1.ltab + 2]) - nxtevn_(
&jsize);
/*< call memadj >*/
memadj_();
/*< return >*/
return 0;
/*< end >*/
} /* extmem_ */